home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IO Examples / Turing / tmdialog.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-25  |  7.8 KB  |  248 lines  |  [TEXT/3PRM]
  1. implementation module tmdialog
  2.  
  3.  
  4. import    StdClass
  5. from    StdFile            import Files
  6. from    StdInt            import ==
  7. import    StdBool, StdString, StdChar, StdTuple
  8. import    deltaDialog
  9. import    deltaEventIO
  10. from    deltaMenu        import EnableMenuItems, DisableMenuItems
  11. from    deltaWindow        import DrawInWindow
  12. import    showtm, tmfile
  13.  
  14.  
  15. ::    *Tm
  16.     =    {    tmstate    :: !TmState
  17.         ,    name    :: !String
  18.         ,    delay    :: !Int
  19.         ,    disk    :: !Disk
  20.         ,    saved    :: !Bool
  21.         }
  22.  
  23.  
  24. HelpFile        :== "TuringHelp"
  25. FileMenuId        :== 2
  26. NewItemId            :== 21
  27. OpenItemId            :== 22
  28. SaveItemId            :== 23
  29. SvAsItemId            :== 24
  30. HelpItemId            :== 25
  31. QuitItemId            :== 26
  32. MachineMenuId    :== 3
  33. StepItemId            :== 31
  34. RunItemId            :== 32
  35. HaltItemId            :== 34
  36. DelayItemId            :== 35
  37. VerSId                    :== 351
  38. SlowId                    :== 352
  39. NormId                    :== 353
  40. FastId                    :== 354
  41. VerFId                    :== 355
  42. WindowID        :== 1
  43. TapeWdID        :== 3
  44.  
  45. ACId            :== 2
  46. ACCancelId            :== 21
  47. ACOKId                :== 22
  48. ACCellId            :== 23
  49. ASId            :== 3
  50. ASCancelId            :== 31
  51. ASOKId                :== 32
  52. ASEditId            :== 33
  53. ATId            :== 4
  54. ATCancelId            :== 41
  55. ATOKId                :== 42
  56. ATRemoveId            :== 43
  57. ATFromId            :== 44
  58. ATHeadId            :== 45
  59. ATToId                :== 46
  60. ATMoveId            :== 47
  61.  
  62. SBCSaveId            :== 51
  63. SBCDontId            :== 52
  64. SBCCnclId            :== 53
  65.  
  66. TimerID            :== 1
  67.  
  68.  
  69. //    The dialog to alter the contents of a tape cell.
  70. AlterCell :: Int Tm (IOState Tm) -> (Tm,IOState Tm)
  71. AlterCell pos tm=:{tmstate={turing={tape}}} io
  72. #    (tm,io)        = DoHiliteCell pos cell  tm io
  73.     (tm,io)        = OpenModalDialog dialog tm io
  74. =    (tm,io)
  75. where
  76.     cell        = CellContents pos tape
  77.     dialog        = CommandDialog ACId "Change Tape Cell" [] ACOKId
  78.                     [    StaticText        1            Center                 "Write:"
  79.                     ,    EditText        ACCellId    (RightTo 1) (MM 15.0) 1 ""
  80.                     ,    DialogButton    ACCancelId    Center                 "Cancel" Able (Cancel pos cell)
  81.                     ,    DialogButton    ACOKId        (RightTo ACCancelId) "OK" Able (Ok pos)
  82.                     ]
  83.     
  84.     Ok :: Int DialogInfo Tm (IOState Tm) -> (Tm,IOState Tm)
  85.     Ok pos dialog tm=:{tmstate} io
  86.                 = (    {tm & tmstate={tmstate & turing={tmstate.turing & tape=newtape}}}
  87.                   ,    DrawInWindow TapeWdID [DrawTapeCell pos cell] (CloseActiveDialog io)
  88.                   )
  89.     where
  90.         cell    = FirstChar (GetEditText ACCellId dialog)
  91.         newtape    = ChangeCellContents pos cell tmstate.turing.tape
  92.     
  93.     Cancel :: Int Char DialogInfo Tm (IOState Tm) -> (Tm,IOState Tm)
  94.     Cancel pos cell dialog tm io
  95.                 = (    tm
  96.                   ,    DrawInWindow TapeWdID [DrawTapeCell pos cell] (CloseActiveDialog io)
  97.                   )
  98.     
  99.     DoHiliteCell :: Int Char Tm (IOState Tm) -> (Tm,IOState Tm)
  100.     DoHiliteCell pos cell tm io
  101.                 = (    tm
  102.                   ,    DrawInWindow TapeWdID [HiliteCell pos cell] io
  103.                   )
  104.  
  105.  
  106. //    The dialog to alter a transition.
  107. AlterTransition :: Int Tm (IOState Tm) -> (Tm,IOState Tm)
  108. AlterTransition tnr tm=:{tmstate={turing={transitions}}} io
  109. #    (tm,io)        = DoHiliteTransition tnr transition tm io
  110.     (tm,io)        = OpenModalDialog dialog       tm io
  111. =    (tm,io)
  112. where
  113.     dialog        = CommandDialog ATId "Change Transition" [] ATOKId
  114.                     [    DynamicText     1            Left (MM 20.0)         "From:"
  115.                     ,    EditText     ATFromId    (RightTo 1) (MM 25.0) 1 transition.start
  116.                     ,    DynamicText     3            Left (MM 20.0)         "With:"
  117.                     ,    EditText     ATHeadId    (RightTo 3) (MM 20.0) 1 (ctos transition.sigma)
  118.                     ,    DynamicText     5            (XOffset ATFromId (MM 10.0)) (MM 20.0) "To:"
  119.                     ,    EditText     ATToId        (RightTo 5) (MM 25.0) 1 transition.end
  120.                     ,    DynamicText     7            (Below 5) (MM 20.0)  "Action:"
  121.                     ,    EditText     ATMoveId    (RightTo 7) (MM 20.0) 1 (ctos transition.move)
  122.                     ,    DialogButton ATCancelId    Center                 "Cancel" Able (Cancel tnr transition)
  123.                     ,    DialogButton ATRemoveId    (RightTo ATCancelId) "Remove" Able (Remove tnr)
  124.                     ,    DialogButton ATOKId        (RightTo ATRemoveId) "OK"      Able (Ok tnr)
  125.                     ]
  126.     transition    = GetTransition tnr transitions
  127.     
  128.     ctos :: Char -> String
  129.     ctos c        = if (c==' ') "" (toString c)
  130.     
  131.     Ok :: Int DialogInfo Tm (IOState Tm) -> (Tm,IOState Tm)
  132.     Ok tnr dialog tm=:{tmstate} io
  133.     #    io                = CloseActiveDialog io
  134.         io                = DrawInWindow WindowID [ShowTrans tnr transition] io
  135.         io                = EnableMenuItems [SaveItemId] io
  136.     =    ({tm & tmstate={tmstate & turing={turing & transitions=newtransitions}},saved=False},io)
  137.     where
  138.         transition        = {    start    = FourCharString    (GetEditText ATFromId dialog)
  139.                           ,    sigma    = FirstChar            (GetEditText ATHeadId dialog)
  140.                           ,    end        = FourCharString    (GetEditText ATToId   dialog)
  141.                           ,    move    = FirstChar            (GetEditText ATMoveId dialog)
  142.                           }
  143.         turing            = tmstate.turing
  144.         newtransitions    = ChangeTransition tnr transition turing.transitions
  145.     
  146.     Cancel :: Int Transition DialogInfo Tm (IOState Tm) -> (Tm,IOState Tm)
  147.     Cancel tnr transition=:{start} dialog tm io
  148.     #    io                = CloseActiveDialog io
  149.     |    start==""        = (tm, DrawInWindow WindowID [EraseTrans tnr] io)
  150.     |    otherwise        = (tm, DrawInWindow WindowID [ShowTrans  tnr transition] io)
  151.     
  152.     Remove :: Int DialogInfo Tm (IOState Tm) -> (Tm,IOState Tm)
  153.     Remove tnr dialog tm=:{tmstate} io
  154.     #    io                = CloseActiveDialog io
  155.         io                = EnableMenuItems [SaveItemId] io
  156.     =    ReDraw    {tm    & tmstate = {tmstate & turing={turing & transitions=newtransitions},transition=0}
  157.                     , saved   = False
  158.                 } io
  159.     where
  160.         turing            = tmstate.turing
  161.         newtransitions    = RemoveTransition tnr turing.transitions
  162.     
  163.     DoHiliteTransition :: Int Transition Tm (IOState Tm) -> (Tm,IOState Tm)
  164.     DoHiliteTransition tnr trans tm io
  165.     #    io    = DrawInWindow WindowID [HiliteTransition tnr trans] io
  166.         io    = DrawInWindow TapeWdID [EraseError] io
  167.     =    (tm,io)
  168.  
  169.  
  170. //    The dialog to alter the state of the T.M.
  171. AlterState :: Tm (IOState Tm) -> (Tm,IOState Tm)
  172. AlterState tm=:{tmstate={turing={state}}} io
  173. #    (tm,io)    = DoHiliteState state    tm io
  174.     (tm,io)    = OpenModalDialog dialog tm io
  175. =    (tm,io)
  176. where
  177.     dialog    = CommandDialog ASId "Change State" [] ASOKId
  178.                 [    StaticText        1            Left                    "State:"
  179.                 ,    EditText        ASEditId    (RightTo 1) (MM 25.0) 1    ""
  180.                 ,    DialogButton    ASCancelId    Center                    "Cancel" Able (Cancel state)
  181.                 ,    DialogButton    ASOKId        (RightTo ASCancelId)    "OK"     Able Ok
  182.                 ]
  183.     
  184.     Ok :: DialogInfo Tm (IOState Tm) -> (Tm,IOState Tm)
  185.     Ok dialog tm=:{tmstate} io
  186.     #    io        = DrawInWindow WindowID [ShowNextState state] io
  187.         io        = changeMenus state    io
  188.         io        = CloseActiveDialog        io
  189.     =    ({tm & tmstate={tmstate & turing={tmstate.turing & state=state}}},io)
  190.     where
  191.         state    = FourCharString (GetEditText ASEditId dialog)
  192.         
  193.         changeMenus :: String (IOState Tm) -> IOState Tm
  194.         changeMenus state io
  195.         |    state=="halt"    = DisableMenuItems [StepItemId, HaltItemId] io
  196.         |    otherwise        = EnableMenuItems  [StepItemId, HaltItemId] io
  197.     
  198.     Cancel :: String DialogInfo Tm (IOState Tm) -> (Tm,IOState Tm)
  199.     Cancel state dialog tm io
  200.     #    io    = CloseActiveDialog io
  201.         io    = DrawInWindow WindowID [ShowNextState state] io
  202.     =    (tm,io)
  203.     
  204.     DoHiliteState :: String Tm (IOState Tm) -> (Tm,IOState Tm)
  205.     DoHiliteState state tm io
  206.     #    io    = DrawInWindow TapeWdID [EraseError] io
  207.         io    = DrawInWindow WindowID [HiliteState state] io
  208.     =    (tm,io)
  209.  
  210.  
  211. //    The function to redraw the entire machine when an update event takes place.
  212. ReDraw :: Tm (IOState Tm) -> (Tm,IOState Tm)
  213. ReDraw tm=:{tmstate={turing={transitions,tape,state}}} io
  214. #    io    = DrawInWindow TapeWdID [ShowTape tape]                        io
  215.     io    = DrawInWindow WindowID [ShowTransitions transitions state]    io
  216. =    (tm,io)
  217.  
  218.  
  219. //    General alert dialog.
  220. Alert :: String String Tm (IOState Tm) -> (Tm, IOState Tm)
  221. Alert mes1 mes2 tm io
  222. #    (_,tm,io)    = OpenNotice (Notice [mes1,mes2] (NoticeButton 1 "OK") []) tm io
  223. =    (tm,io)
  224.  
  225.  
  226. //    Save before close dialog.
  227. SaveBeforeClose :: String Tm (IOState Tm) -> (Bool,Tm,IOState Tm)
  228. SaveBeforeClose mes tm=:{name} io
  229. #    (butid,tm,io)        = OpenNotice notice tm io
  230. |    butid==SBCSaveId    = SvBfClSave tm io
  231. |    butid==SBCDontId    = (True ,tm,io)
  232. |    otherwise            = (False,tm,io)
  233. where
  234.     notice                = Notice
  235.                             [    "Save changes to \""+++RemovePath name+++"\""
  236.                             ,    "before "+++mes+++"?"
  237.                             ]    (NoticeButton SBCSaveId "Yes")
  238.                             [    NoticeButton SBCDontId "No"
  239.                             ,    NoticeButton SBCCnclId "Cancel"
  240.                             ]
  241.     
  242.     SvBfClSave :: Tm (IOState Tm) -> (Bool,Tm,IOState Tm)
  243.     SvBfClSave tm=:{tmstate={turing},name,disk,saved} io
  244.     =    (    True
  245.         ,    {tm & disk=snd (WriteTuringToFile turing name disk),saved=True}
  246.         ,    DisableMenuItems [SaveItemId] io
  247.         )
  248.